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R5 = Current Instruction Offset within application buffer 

R6 = Current Instruction Address within application buffer 

R7 = Work Register - used for calculating offsets, etc 

R12 = Base register of code generator and template code 

SLR R5,R5 clear offset 

L R6 , $BCB_BCODE_@ get address of user buffer 



* if linkage required call standard linkage builder 
IF (TM, $BCB_PFLAG1 , $BCB_LINKAGE, 0) 

SETF LINKAGE 

IF (CLI , $BCB_LINKAGE_TYPE, EQ, C ' N ' ) 

RESETF LINKAGE 
COND ELSE 

* call standard linkage builder 

#BAS 14 , =A (BURST_ENTRY_LINKAGE) 
ENDIF 
ELSE 

RESETF LINKAGE 

ENDIF 
**★* 

STDRETURN - RETURN TO APPLICATION 

* $BCB_BCODE_@ WILL POINT TO BUILT CODE 

* * ** 

* 

* Routine to build standard entry linkage 
★ 

BURST_ENTRY_L INKAGE CSMSUBI BASE=R10 , W0RKREG=R3 

* Move Template code into user buffer 

MVC 0 { STD_ENTL_0 1 0__L , R6 ) , STD_ENTL_0 1 0 

* 

* Modify " LA R14,0(0)" instruction 

* Get Offset to Savearea using equate STD_ENTL_010_SA_A 

* Set base register for instruction to R12 

* Set D(X,B) of instruction (R7 contains constructed D(X,B)) 

LA R7 , STD JENTL_0 1 0_SA_A ( , R5 ) 

O R7,=X , 0000C000' 

STH R7 , STD_ENTL_010_SA_T ( , R6 ) 

* 
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* Modify " B 0(R12) M instruction 

* Get offset of branch target using equate STD_ENTL_010_B_A_T 

* Set D(X,B) of instruction (R7 contains constructed D(X,B)) 

* ** Note X (index register) has been set by assembler as R12 

* STH does not change the instruction's index register 

LA R7,STD_ENTLJ)10_B_AJT(,R5) CALC OFFSET FOR BRANCH TARGET 
STH R7,STD_ENTL_010_B_A(,R6) SET BRANCH D(X,B) 

* 

* Increment Next Instruction Offset (in R5) by length of code 

* Increment Next Instruction Address (in R6) by length of code 

LA R5 , STD_ENTL_0 1 0_L ( , R5 ) 
LA R6 , STD_ENTL_0 1 0_L ( , R6 ) 

★ 

* Return to caller 

* Code has been built and the Instruction Offset and Address. registers 

* have been updated for next instruction construction 
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*- STANDARD ENTRY 
* 








STD ENTL_010 DS 


OS 






STM 


R14,R12, 12 (R13) 






STD_ENTL_0 1 0_SA_T 


EQU * - STD_ENTL_0 10+2 






LA 


R14, 0 (0) 


BURSTED SAVEAREA+0 




ST 


R13,4 (,R14) 






ST 


* R14,8(,R13) 






LR 


R13,R14 


R13 = BURSTED SAVEAREA 


i : 


LR 


R12,R15 


SET BURSTED BASE REG 




STD_ENTL_0 1 0_B_A 


EQU * - STD_ENTL_0 10+2 






B 


0 (R12) 


WS_ BRANCH 




STD ENTL_010_SA_A 


EQU * - S TD_ENTL_0 1 0 






DC 


18F' 0 ' 






STD JSNTL_0 1 0_B_A_ 


T EQU *-STD_ENTL_010 






STD_ENTL_010_L 


EQU * - STD_ENTL_0 1 0 
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•* Call made by API passing API $BURSTCB control block 

* Control block contains field attributes and conversion 

* options 

* Reset processing flags 

* NO BUILD -> doing conversion routine storage calculation 

* CALLED_ROUTINE -> creating a called routine 

* Check for API block -> if not there abend with dump 

* Copy passed API block to working storage (IN_BCB) 



MAIN_0000 
* 


DS 


OS 




RESETF 
RESETF 


NO_BUILD 
CALLED_ROUTINE 


★ 


LTR 
BNZ 


R1,R1 
MAIN_0005 


* 


ABEND 


001, DUMP 


* iO 

MAJlL0005 


DS 
MVC 


OS 

IN_BCB ($BCB_LENGTH) , 0 (Rl) 


* i?i 


LA 

USING 


R9 , IN_BCB R9 
$BURSTCB,R9 



R9 = ADDRESS OF $BURSTCB 

* 'if calculate storage requested SET NO_BUILD 

L IF (CLC, $BCB_FUNC, EQ, =Y ( $BCB_CALC_STORAGE) ) 

SETF NOJBUILD 
W ENDIF 

* INITIALIZE WORKING STORAGE 

* iflf actually BUILDING code (not NO_BUILD) 

* To 1- Obtain offset from beginning of BASE REGISTER 

* : " for code. If callable routine this has been set to 0. 

* otherwise this we are building inline code within the application's 

user managed buffer and the offset will set to current instruction offset 

* within the buffer. 

* 2. Obtain address of passed code buffer 

* 3. Calculate current instruction address based on offset into buffer 
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MAIN_STRT DS OS 

IF (-.NO_BUILD) 

LH R5 , $BCB_BCODE_OFFSET 

L R6 , $BCB_BCODE_@ 

LA R6,0{R5,R6) 
ELSE 

SLR R5 # R5 CLEAR FOR ACCUM 

SLR R6,R6 CLEAR FOR ACCUM 

ENDIF 

* 

* INITIALIZE WORK FIELDS FOR ANY COLUMN CONVERSION 

* 1. Obtain input fields addressing register 

* 2. Build RX type assembler instruction D(X,B) with offset 0 

* 3. Obtain output field's addressing register 

* 4. Build RX type assembler instruction D(X,B) with offset 0 

* set template for output D(X,B) 

* 5. Obtain input and output lengths 

* 6. Set Current working D(X,B) templates 





SLR 


R7,R7 








I CM 


R7,B'0001' , $BCB_IREG 








SLL 


R7,4 


SHIFT 


NIBBLE 


kU 


STC 


R7 , WB_INIT_SOURCE_DB 








ICM 


R7,B' 0001 ' , $BCB_OREG 








SLL 


R7,4 


SHIFT 


NIBBLE 


\~\ 


STC 


R7 , WB_INIT_TARGET_DB 








MVC 


WB_TOT_INPUT_LEN, $BCB_ILEN 








MVC 


WB TOT_OUTPUT_LEN, $BCB_OLEN 








MVC 


WB SOURCE_DB,WB_INIT_SOURCE_DB 


RESET 


DB 




MVC 


WB TARGET_DB , WB_INIT_TARGET_DB 


RESET 


DB 



* CfiECK FOR LINKAGE REQUIREMENTS 

* I fej LINKAGE = E (BASIC ENTRY - SAVE/RESTORE R14) THEN 

* MBURST_WORK_BRANCH WILL SAVE R14 AND SET RESTORE_R14 

* I f% BURS T_EX I T_L I NKAGE RESTORES R14 AND BASR R14 

* El|pIF 

RESETF RESTORE_R14 
' y IF (TM, $BCB_PFLAG1, $BCB_LINKAGE , 0) 

SETF LINKAGE 

IF (CLI , $BCB_LINKAGE_TYPE , EQ , C ' N ' ) 

RESETF LINKAGE 
COND ELSE 

#BAS 14 , =A (BURST_ENTRY__LINKAGE) 

ENDIF 
ELSE 

RESETF LINKAGE 
ENDIF 
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* CALL INPUT TYPE PROCESSING ROUTINE 

* l. Get address of input field type table 

* This table contains an index of supported input types 

* with their associated code generation routines 

* 2. Call code generation routine for Input field type 

* In this case INPUT FIELD TYPE IS CHARACTER 

* INPUT FIELD TYPE CHARACTER calls routine named CHARACTER 
**** Further down subroutine CHARACTER is shown 

L R14 , =A (TYPE_TABLE) 

LH R15, $BCB_ITYPE 

LA R15,0(R14,R15) 
L R15,0(,R15) 
BASR R14,R15 

* Subroutine has built conversion code for INPUT TYPE CHARACTER and OUTPUT TYPE CHARACTER 

* Check for other process options such as: accumulate a source addressing register, 

* accumulate a target addressing register, or accumulate alternate register. 

* alternate register usually is a total output length accumulator used by the calling 

* application to keep track of an aggregate of all output field lengths 

* l. IF source addressing register accumulate requested build code to accumulate 

* 2. IF target addressing register accumulate requested build code to accumulate 

* 313 IF length register accumulate requested build code to accumulate 

* 4j~4 IF exit linkage requested build exit linkage 

* 5§i1 RETURN TO API CALLER with generated conversion routine 
MAlK 0200 DS OS 

S T IF (TM, $BCB_PFLAG1 , $BCB_SRC_ACUM , 0) 

^ LH R0 , WB_SOURCE_ACCUM_INDEX 

^ IC Rl, $BCB_SRC_ACUM_REG 

# LH R7 , WB JTOT_INPUT_LEN 

?0 #BAS 14 , =A (FIXED_ACCUM) 

ENDIF 

* f^- 

yj IF (TM, $BCB_PFLAG1, $BCB_TRG_ACUM, 0) 

rf LH R0 , WB_TARGET_ACCUM_ INDEX 

^ IC Rl, $BCB_TRG_ACUM_REG 

LH R7 , WB_TOT_OUTPUT_LEN 

^ #BAS 14, =A(FIXED_ACCUM) 

*U ENDIF 

* 

IF (TM, $BCB_PFLAG1 , $BCB_TRG_L_ACUM, 0) 

LH R0 , WB_TARGET_ACCUM_INDEX 

IC Rl , $BCB_TLN_ACUM_REG 

LH R7 , WB_T0T_0UTPUT_LEN 

#BAS 14 , =A (FIXED_ACCUM) 
ENDIF 

* 

* BURST EXIT LINKAGE 

IF (LINKAGE) 

SETF CLEAR_R15 

#BAS 14 , =A (BURST_EXIT_LINKAGE) 
ENDIF 

RETURN to CALLER 
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* -- * 

* Character Input Field Type Conversion Routine * 

* Abstract: * 

* This routine is called to either build Character Input * 

* Fields to all supported Output Field Types, or to calculate * 

* storage requirements for generated conversion routines for * 

* Input field type Character * 

* * 

* CHARACTER field type constraints * 

* These field types will be of fixed length * 

* Haximum length is 254 8bit bytes * 

* They may be proceeded with a null field indicator of length * 

* 1 byte that will contain values of x'OO 1 for non-null fields * 

* and x'ff ' for nulled fields. Nulled fields will not be * 

* - converted accept to indicate on output that field was null * 

* There values are of EBCDIC CCSID (character code set) unless * 

* a CCSID is specified through the API. * 

* * 
* - * 



CHA£&CTER CSMSUBI BASE=R10,WORKREG=R3 

* Uke branch table generated by API to branch on output type (BTYPE=0) 

* Example is demonstrating character to character conversion 

* BBlnch will be taken to CHAR_CHAR_0000 

SJ L R15,=A(RET_RC_32) 



j 2 ij 


$BURST B TABLE, 


X 


! - 


BREG=1 , 


X 




BTYPE=0, 


X 




UNSUPPORTED^ ( , R15 ) , 


X 




CHAR = CHAR_CHAR_ 0 000, 


X 




LVARC=OIAR_VARC_0 0 00, 


. X 




VARC=CHAR VARC 0 000 





* - ©HSEUDO - CODE® 

* kQ CHARACTER TO CHARACTER CONVERSION 

* ^fi 

* -ifpETERMINE WORKING STORAGE 

* Some conversions require the generation of local working storage 

* Working storage is generated according to specific conversion options and 

* specific input and output field attributes to avoid generating more storage 

* than needed. 
* 

* IP CONVERTING CCS ID'S (character code sets) THEN 

* IF using a character translation table (uses TR instruction) 

* Build BRANCH over working storage 

* Build FULL WORD to hold Address character translation table 

* UPDATE Previously built Branch instruction to branch to current offset 

* (offset is next halfword aligned byte where next instruction is to be built) 

* ENDIF 

* ENDIF 
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* IF INPUT LENGTH is GREATER than OUTPUT LENGTH 

* current implementation allows for truncation of trailing spaces 

* If input field being converted by generated code contains non- spaces 

* that won't fit into output field of lesser length then conversion 

* error 4 routine will be called to return a value of 4 in R15 
* 

* 1. Build BRANCH over working storage 

* 2. Build a buffer full of spaces to be used in INPUT field compare 

* 3. Build Conversion error routine to return error #4 

* 4. UPDATE Previously built Branch instruction to branch to current offset 

* (offset is next halfword aligned byte where next instruction is to be built) 

* ENDIF 

* - DETERMINE WORKING STORAGE 
* 

*-@PSEUDO-CODE@ CHAR_CHAR_0000 DS OS 

* 

* BURST WORKAREA IF CONVERSION ERROR OR CONVERT CCS ID 

TM $BCB_PFLAG2 , $BCB_CCSID_CNV 

BNZ CHAR_CHAR_0 02 0 
CLC $BCB_ILEN, $BCB_OLEN 
P1 BNH CHAR_CHAR_004 0 

* 

CHaM^CHAR_0020 DS OS 

! *f #BAS 14 , =A (BURST_WORK_BRANCH) 

* "~-4 

\M IF (TM, $BCB_PFLAG2 , $BCB_CCSID_CNV, N2) 

IF (TM, $BCB_PFLAG2 , $BCB_CCSID_CNV_ATOE, 0) 
s p #BAS 14 , = A ( BURST_BWKJTO_E_XLATE_@ ) 

ifl ELSE 

#BAS 14 , =A (BURST_BWK_TO_0_XLATE_@) 
q ENDIF 

ji #BAS 14 , =A (BURST_BWK_FULL) 

STH R7 , WB_SAVE_R2_OFFSET 
\I ENDIF 

* : -U 

* IiSlLEN > OLEN THEN NEED FOLLOWING WORK FIELDS 

* BURST BUFFER255 - SPACES 

* BURST #@ERROR4 CALL 

* ENDIF 

IF (CLC,$BCB_ILEN,GT,$BCB_OLEN) 

#BAS 14 , =A (BURST_BWK_BUFFER255) 

* 

it 

LA Rl , 4 #@ERR0R4 

#BAS 14 , =A (BUILD_CNVERR) 
ENDIF 

* 

#BAS 14 # =A ( UPDATE_W0RK_B RANCH ) 
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w 

* IF OUTPUT NULLABLE THEN 

* BURST MOVEMENT OF NULL INDICATOR 

* Rl = X*00' FOR MVI Instruction Builder 

* WB_TARGET_DB (current target D (B) ) USED FOR INDICATOR LOCATION 

* Build MVI OF NULL INDICATOR (MVI_0000) 

* UPDATE Current TARGET D(B) TO ALLOW DATA TO SKIP NULL INDICATOR 

* ADD 1 TO TOT OUTPUT LENGTH (FOR NULL INDC) (this allows for accumulation requests) 

* ENDIF 

CHAR_CHAR_0040 DS OS 

IF (TM, $BCB OFLAGl,$BCB_ONULL,0) 



SLR 


R1,R1 


CLEAR SOURCE BYTE 


#BAS 


14,=A(MVI_0000) 


BURST MVI NULL INDC 


LH 


Rl , WB_TARGET_DB 


UPDATE TARGET DB 


LA 


R1,M,R1) 




STH 


Rl , WB_TARGET_DB 




LH 


Rl , WBJTOT_OUTPUT_LEN 


UPDATE OUTPUT LEN 


LA 


R1,1(,R1) 




STH 


Rl , WB_TOT_OUTPUT_LEN 




ENDIF 







* input length < then output length 

* ;j? call routine to build code to pad output field with spaces 

* ILsE 

* IF input length = Output length 

* t&J Call routine to build an MVC instruction 

* M This routine uses current source and target D(B) ! s 

* .g and the output length to construct the instruction 

* ijg ELSE 

* input length > output length 

* ~ Call routine to build an MVC instruction 

* I7; This routine call will use the input length (since it shorter) 

* *fj (source and target D(B) f s will be used 

* Build Code to check for truncation of only spaces 

* ±B ENDIF 

* ySNDIF 



LH 


R1,$BCB_ILEN 


GET INPUT LEN 


LH 


R2 , $BCB_OLEN 


GET OUTPUT LEN 


CR 


R1,R2 


CHECK LENGTHS 


BE 


CHAR_CHAR_0050 


EQUAL 


BH 


CHAR_CHAR_0100 


I > 0 -> 



* INPUT LENGTH LESS THAN OUTPUT -> NEED TO PAD 

* Build Character padding code 

#BAS 14 , =A (SSP_0000) 

* 

* Build code TO MOVE CHARACTER FIELD TO CHARACTER FIELD 
CHAR_CHAR_0050 DS OS 

#BAS 14,=A(MVC_0000) BURST MVC INSTRUCTION 

B CHAR CHAR 02 00 
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* INPUT field is too large to fit 

* Build code TO MOVE CHARACTER FIELD TO CHARACTER FIELD using input field 1 s length 
CHAR_CHAR_0100 DS OS 

LR Rl , R2 

#BAS 14,=A(MVC_0000) BURST MVC INSTRUCTION 

* 

* MOVE CHECK FOR SPACES 

* IF TRUNCATED DATA NOT SPACES THEN #@ERROR4 



IF (-<NO_BUILD) 

* 

MVC 0 ( CHAR_CHAR_0 1 0_L ,R6) , CHAR_CHAR_0 1 0 

* SET LENGTH OF COMPARE 

LH R7 , $BCB_ILEN 

SR R7 , Rl 

BCTR R7 , 0 

STC R7 , CHAR_CHAR_010_OLEN_A ( , R6 ) 

* SET SOURCE DB TO SOURCE + OLEN-1 

LH R7 , WB_SOURCE_DB 

^ LA R7,0(R1,R7) 

BCTR R7 , 0 

jj: STH R7,CHAR_CHAR_010_SDBN_A(,R6) 

* UPfATE BUFFER OFFSET 

LH R7 , WB JBUFFER2 5 5_OFFSET 

M; O R7,=X'O000C00O' 

if STH R7,CHAR_CHAR_010_B255_A(,R6) 

* -O 

* UPDATE #@ERROR4 BRANCH 

fj LH R7 , WB_CNVERR4_OFFSET 

jTj STH R7,CHAR_CHAR_010_BERR_A(,R6) 

* :"T 

^ ENDIF (NO_BUILD) 

LA R5 , CHAR _CHAR_0 1 0_L ( , R5 ) 

=0 LA R6 , CHAR CHAR 010 L(,R6) 
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* CHECK FOR TRANSLATION of CCSID'S 

* If translation requested call translation routine generator 

* *** note translation routine will perform accumulation 

* operation if API requested it. If accumulation is performed 

* by the routine the IN_BCB (copy of API block used by generator) 

* will be updated to turn off accumulation by the main process 

* done upon CHARACTER subroutine (see above) 
CHAR_CHAR_0200 DS OS 

IF (TM, $BCB_PFLAG2 , $BCB_CCSID_CNV,NZ) 

* IF IREG =2 AND SRC_ACCUM TR INST WILL BUMP REG 
SETF SAVE_R2 

IF ( CLC , $BCB_IREG , EQ , =H 1 2 1 ) , AND , X 
(TM, $BCB_PFLAG1 , $BCB_TRG_ACUM+$BCB_TRG_L_ACUM , NZ) 
RESETF SAVE_R2 

NI $BCB_PFLAG1 , X 1 FF ' - $BCB_SRC_ACUM 

ENDIF 

RESETF XLATE_TO_E 

IF (TM , $BCB_PFLAG2 , $BCB_CCSID_CNV_ATOE , O) 

SETF XLATEJTOJE 
ENDIF 

O #BAS 14 , =A (DO_XTAB_SHORT) 

?0 ENDIF 

* ru 

CHARy[9999 DS OS 

s.s B CHARACTER END 

r I 

* B^RST CHARACTER TO CHARACTER ILEN > OLEN 

* t||«PLATE CODE USED FOR NON- SPACE TRUNCATION 

* _ J-M 

CHAR CHAR_010 DS OS 

chaITchar 010_OLEN_A EQU *-CHAR_CHAR_010+l LEN OF CLC 
CHAkI~CHAR_010_SDBN_A EQU * -CHAR_CHAR_010+2 LOC OF SOURCE TO COMP 
CHAE£~CHAR 010 B255 A EQU *-CHAR_CHAR_010+4 LOC OF 255 SPACES 

[q "CLC" 070,0) ,0(0) SDB+(OLEN-l) ,BWK_BUFF255 

CHArJ CHAR 010 BERR A EQU * - CHAR_CHAR_0 10+2 

'f "BNE~ 0TR12) NOT SPACES? -> #@ERROR4 

CH^ CHAR 010 L EQU * - CHAR_CHAR_0 1 0 
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